perm filename CHESS.SAI[4,KMC]1 blob sn#177285 filedate 1975-09-17 generic text, type C, neo UTF8
COMMENT ⊗   VALID 00004 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	BEGIN
C00006 00003		ELSE	BEGIN
C00010 00004	PROCEDURE TESTIT
C00013 ENDMK
C⊗;
BEGIN

REQUIRE "IODEFS.SAI[SEC,RCP]" SOURCE_FILE;

PROC BKMOVE(VALUE INTEGER BKX, BKY, WKX, WKY, WRX, WRY;
		REFERENCE INTEGER NBKX, NBKY);
	BEGIN

	α ILLEGAL returns true if X,Y is off the board;
	BOOLEAN PROC ILLEGAL(VALUE INTEGER X, Y);
		RETURN((X<1) OR (X>8) OR (Y<1) OR (Y>8));

	α NEXT_TO returns true if A is next to B;
	BOOLEAN PROC NEXT_TO(VALUE INTEGER AX, AY, BX, BY);
		RETURN((ABS(AX-BX) ≤ 1) AND (ABS(AY-BY) ≤ 1));

	α CHECKED returns true if Black King can't move to square X,Y;
	BOOLEAN PROC CHECKED(VALUE INTEGER X, Y);
		RETURN(ILLEGAL(X,Y) OR NEXT_TO(X,Y,WKX,WKY) OR
		(X = WRX) AND ¬((WKX = X) AND ((WRY-WKY) * (WKY-Y) > 0)) OR
		(Y = WRY) AND ¬((WKY = Y) AND ((WRX-WKX) * (WKX-X) > 0)));

α BKMOVE returns (0,0) when the game must be stopped.;
	NBKX ← NBKY ← 0;
	OUTSTR(NULL ↓);
α All 6 coordinates must be  1 ≤ coord ≤ 8;
α Two pieces can't be in the same place;
α The kings can't be adjacent;
	IF ILLEGAL(WKX, WKY) OR ILLEGAL(WRX, WRY) OR ILLEGAL(BKX, BKY) THEN
		OUTSTR("Weird board - pieces not on board" ↓)
	ELSE IF (WKX=BKX) AND (WKY=BKY) OR
		(WKX=WRX) AND (WKY=WRY) OR
		(BKX=WRX) AND (BKY=WRY) THEN
		OUTSTR("Weird board - 2 pieces superimposed" ↓)
	ELSE IF NEXT_TO(WKX,WKY,BKX,BKY) THEN
		OUTSTR("Weird board - Kings adjacent" ↓)
	ELSE	BEGIN
		STRING ARRAY BOARD[1:16,1:8];
		INTEGER J;
		PROC PRINT_BOARD(VALUE INTEGER WIDTH);
			FOR I ← 8 STEP -1 UNTIL 1 DO
				BEGIN
				FOR J ← 1 TIL 8 DO
					OUTSTR(BOARD[J, I] & " ");
				OUTSTR("     ");
				FOR J ← 9 TIL WIDTH DO
					OUTSTR(BOARD[J, I] & " ");
				OUTSTR(NULL ↓);
				END;
α Set up board before black move;
		FOR I ← 1 TIL 8 DO
			FOR J ← 1 TIL 16 DO
				BOARD[J, I] ← "+";
		BOARD[WKX, WKY] ← "W";
		BOARD[WRX, WRY] ← "R";
		BOARD[BKX, BKY] ← "B";
		BOARD[WKX+8, WKY] ← "W";
		BOARD[WRX+8, WRY] ← "R";
α See if can take rook;
		IF NEXT_TO(BKX,BKY,WRX,WRY) AND ¬NEXT_TO(WKX,WKY,WRX,WRY) THEN
			BEGIN
			BOARD[WRX+8, WRY] ← "B";
α Print both boards after black capture;
			PRINT_BOARD(16);
			OUTSTR("Rook captured - drawn game" ↓);
			END
		ELSE	BEGIN
α See if can move towards middle;
α See if can move towards rook;
			INTEGER A, B, C, D, E, F, G, H;
			A ← IF BKX≤4 THEN 1 ELSE -1;
			B ← IF BKY≤4 THEN 1 ELSE -1;
			IF BKX*(9-BKX) ≥ BKY*(9-BKY) THEN
				BEGIN C←0; D←B; E←A; F←0; G←-A; H←B; END
			ELSE	BEGIN C←A; D←0; E←0; F←B; G←A; H←-B; END;
			IF ¬CHECKED(BKX+A,BKY+B) THEN
				BEGIN NBKX←BKX+A; NBKY←BKY+B; END
			ELSE IF ¬CHECKED(BKX+C,BKY+D) THEN
				BEGIN NBKX←BKX+C; NBKY←BKY+D; END
			ELSE IF ¬CHECKED(BKX+E,BKY+F) THEN
				BEGIN NBKX←BKX+E; NBKY←BKY+F; END
			ELSE IF ¬CHECKED(BKX+G,BKY+H) THEN
				BEGIN NBKX←BKX+G; NBKY←BKY+H; END
			ELSE IF ¬CHECKED(BKX-G,BKY-H) THEN
				BEGIN NBKX←BKX-G; NBKY←BKY-H; END
			ELSE IF ¬CHECKED(BKX-E,BKY-F) THEN
				BEGIN NBKX←BKX-E; NBKY←BKY-F; END
			ELSE IF ¬CHECKED(BKX-C,BKY-D) THEN
				BEGIN NBKX←BKX-C; NBKY←BKY-D; END
			ELSE IF ¬CHECKED(BKX-A,BKY-B) THEN
				BEGIN NBKX←BKX-A; NBKY←BKY-B; END
			ELSE	BEGIN
α Print only initial board;
				PRINT_BOARD(8);
α See if in checkmate;
α See if in stalemate;
				IF CHECKED(BKX, BKY) THEN
					OUTSTR("Black is checkmated" ↓)
				ELSE OUTSTR("Stalemate - drawn game" ↓);
				END;
			IF (NBKX ≠ 0) THEN
				BEGIN
α Set up board after black move;
				BOARD[NBKX+8, NBKY] ← "B";
α Print both boards after black move;
				PRINT_BOARD(16);
				OUTSTR("Your move" ↓);
				END;
			END;
		END;
	IF (NBKX=0) THEN OUTSTR("Game over" ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓);
	END;
PROCEDURE TESTIT;
	BEGIN
	INTEGER WKX, WKY, WRX, WRY, BKX, BKY;
	STRING POSITION;
	POSITION ← GET_A_STRING("B King X,Y  W King X,Y  W Rook X,Y");
	BKX ← INTSCAN(POSITION, BRK);
	BKY ← INTSCAN(POSITION, BRK);
	WKX ← INTSCAN(POSITION, BRK);
	WKY ← INTSCAN(POSITION, BRK);
	WRX ← INTSCAN(POSITION, BRK);
	WRY ← INTSCAN(POSITION, BRK);
	BKMOVE(BKX, BKY, WKX, WKY, WRX, WRY, BKX, BKY);
	END;

WHILE TRUE DO TESTIT;

END